home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / front.lha / front / src / Oper.mi < prev    next >
Text File  |  1992-08-18  |  10KB  |  330 lines
  1. (* handle oper section *)
  2.  
  3. (* $Id: Oper.mi,v 2.2 1992/08/07 15:13:51 grosch rel $ *)
  4.  
  5. (* $Log: Oper.mi,v $
  6.  * Revision 2.2  1992/08/07  15:13:51  grosch
  7.  * allow several scanner and parsers; extend module Errors
  8.  *
  9.  * Revision 2.1  1991/11/21  14:47:50  grosch
  10.  * new version of RCS on SPARC
  11.  *
  12.  * Revision 2.0  91/03/08  18:26:19  grosch
  13.  * turned tables into initialized arrays (in C)
  14.  * moved mapping tokens -> strings from Errors to Parser
  15.  * changed interface for source position
  16.  * 
  17.  * Revision 1.1  90/06/11  18:45:05  grosch
  18.  * layout improvements
  19.  * 
  20.  * Revision 1.0     88/10/04  14:26:55  vielsack
  21.  * Initial revision
  22.  * 
  23.  *)
  24.  
  25. IMPLEMENTATION MODULE Oper;
  26.  
  27. FROM Lists    IMPORT MakeList, tList;
  28. FROM Strings    IMPORT tString, ArrayToString;
  29. FROM Idents    IMPORT tIdent;
  30. FROM Memory    IMPORT Alloc;
  31. FROM SYSTEM    IMPORT ADR, TSIZE;
  32. FROM Positions    IMPORT NoPosition;
  33.  
  34. FROM TokenTab    IMPORT MAXTerm, cMAXTerm, Terminal, Vocabulary, PosType,
  35.                 GetPrio, PutPrio, Prio, TokenError, GetTokenType,
  36.                 Term,NonTerm, SymbolToToken, MakeTerm;
  37.  
  38. FROM Errors    IMPORT    eFatal, eRestriction, eError, eIdent, eString, eInternal,
  39.             ErrorMessage, ErrorMessageI;
  40.  
  41.  
  42.   CONST
  43.     eNoIntCode = 25;    eTokenOverflow = 26;    eNoTerm = 40;
  44.     eTokenInPrio = 35;
  45.  
  46.   TYPE
  47.     Priorities = POINTER TO Priority;
  48.     Operators = POINTER TO Operator;
  49.  
  50.     Priority = RECORD
  51.     Kind   : OperKind;
  52.     KindPos: PosType;    (* Position von 'LEFT' bzw 'RIGHT' *)
  53.     List   : Operators;
  54.     Comment: tList;
  55.     CommPos: PosType;
  56.     Next   : Priorities;
  57.       END;
  58.     
  59.     Operator = 
  60.       RECORD
  61.     Token     : Vocabulary;
  62.     TokenPos : PosType;   (* Position des einzelnen Zeichens *)
  63.     List     : Operators;
  64.       END;
  65.  
  66.   VAR
  67.     OperVars:
  68.       RECORD
  69.     OPERPos : PosType;    (* Position von 'OPER' *)
  70.     Comment : tList;
  71.     CommPos : PosType;
  72.       END;
  73.  
  74.     ReadyForOperator: (*TRUE : MakeOperator,MakePriority und
  75.                    CompletePriority zulaessig *)
  76.       BOOLEAN;          (*FALSE : MakePriority zulaessig *)
  77.        
  78.     WPrio:      (* Zeigt auf die zuletzt mit MakePriority eingetragene *)
  79.       Priorities; (* Prioritaet *)
  80.  
  81.     StartPrio:      (* Zeigt auf die zuerst mit MakePriority eingetragene     *)
  82.       Priorities; (* Prioritaet *)
  83.        
  84.     RPrio:      (* Zeigt auf die beim naechsten Mal zu lesende *)
  85.       Priorities; (* Prioritaet *)
  86.  
  87.     INTOPERExists : BOOLEAN;
  88.     CurrentPrio: Prio;
  89.  
  90.     WOp,       (* Schreibzeiger innerhalb der Operanden einer Prioritaet *)
  91.     ROp:       (* Lesezeiger      "           "    "          "           "     *)
  92.       Operators;
  93.  
  94.     GetOperatorAllowed: BOOLEAN;(* ueberprueft, ob GetOperator nach      *)
  95.                 (* gueltigem GetPriority aufgerufen wurde *)
  96.  
  97.     OpenForReading    : BOOLEAN;(* Wird beim Aufruf von InitPrioReading      *)
  98.                 (* TRUE, somit Lesen und kein weiteres      *)
  99.                 (* Schreiben erlaubt.              *)
  100.  
  101.   PROCEDURE MakePriority (Kind: OperKind; Pos: PosType); 
  102.   
  103.   (* Festlegen einer neuen Assoziativitaet (LEFT/RIGHT) und damit einer
  104.      neuen, d.h. um eins erniedrigten Prioritaet . *)
  105.   
  106.   VAR  HPrio :
  107.        Priorities;
  108.  
  109.   BEGIN
  110.     IF OpenForReading THEN
  111.        ERROR ('MakePriority : Do not write now ');
  112.     END;
  113.     ReadyForOperator := TRUE; 
  114.     HPrio := Alloc(TSIZE(Priority));
  115.     IF HPrio = NIL THEN
  116.       ERROR ('MakePriority : Heap overflow');
  117.     END;
  118.     HPrio^.Kind       := Kind;
  119.     HPrio^.KindPos := Pos;
  120.     HPrio^.List      := NIL;
  121.     WOp          := NIL;
  122.     HPrio^.Next      := NIL;
  123.     (* Comment wird initialisiert,falls CompletePrio nicht ayfgerufen
  124.        wird *)
  125.     MakeList (HPrio^.Comment);
  126.     HPrio^.CommPos.Line := 0;
  127.     HPrio^.CommPos.Column:= 0;
  128.  
  129.     (* WPrio ist nur dann NIL, wenn noch keine Prioritaet eingetragen 
  130.        wurde *)
  131.     IF WPrio <> NIL THEN
  132.       WPrio^.Next  := HPrio
  133.     ELSE
  134.       StartPrio := HPrio;
  135.     END;
  136.     (* Fortschalten des Schreibzeigers *)
  137.     WPrio       := HPrio;
  138.     (* Heraufsetzen der Prioritaet *)
  139.     INC(CurrentPrio);
  140.   END MakePriority;
  141.  
  142.   PROCEDURE CompletePriority (Comment: tList; CommPos: PosType);
  143.       
  144.   (* Eintragen des zu einer Prioritaet gehoerigen Kommentars,  
  145.      gleichzeitig Abschluss dieser Prioritaet *)
  146.  
  147.   BEGIN
  148.     IF NOT ReadyForOperator THEN  
  149.       ERROR ('CompletePriority : Wrong use of procedure');
  150.     END;
  151.     IF OpenForReading THEN
  152.       ERROR ('CompletePriority : Do not write now');
  153.     END;
  154.     WPrio^.Comment := Comment;
  155.     WPrio^.CommPos := CommPos;
  156.     ReadyForOperator := FALSE;
  157.   END CompletePriority;
  158.  
  159.   PROCEDURE MakeOperator (Token: tIdent; TokenPos: PosType);
  160.  
  161.   (* Eintragen des naechsten Operators mit der aktuellen Prioritaet.
  162.      Nur zulaessig nach MakePriority und vor CompletePriority. *)
  163.  
  164.   VAR HOper    :  Operators;
  165.       HToken   :  Vocabulary;
  166.       Error    :  TokenError;
  167.       ter      :  Terminal;
  168.   BEGIN
  169.     IF NOT ReadyForOperator THEN  
  170.       ERROR ('makeOperator : Wrong use of procedure');
  171.     END;
  172.     HToken := SymbolToToken(Token,Error);
  173.     IF Error = NotExists THEN
  174.       HToken := MAXTerm+1;
  175.       IF HToken > cMAXTerm THEN
  176.     ErrorMessage (eTokenOverflow,eRestriction, TokenPos);
  177.       END;
  178.       ter := HToken;
  179.       MakeTerm (Token,ter,Error,TokenPos);
  180.       IF Error = OutOfRange THEN
  181.     ErrorMessage (eTokenOverflow,eRestriction, TokenPos);
  182.       END;
  183.     ELSIF Error = NoIntCode THEN
  184.       ErrorMessageI(eNoIntCode,eFatal,NoPosition,eIdent,ADR(Token));
  185.     END; 
  186.        
  187.     IF GetTokenType(HToken) # Term THEN
  188.       ErrorMessageI(eNoTerm,eError,TokenPos,eIdent,ADR(Token));
  189.     ELSIF GetPrio(HToken) <> 0 THEN
  190.       ErrorMessageI (eTokenInPrio,eError, TokenPos,eIdent, ADR(Token));
  191.     ELSE
  192.       PutPrio (SymbolToToken(Token,Error),CurrentPrio);
  193.       HOper := Alloc(TSIZE(Operator));
  194.       IF HOper = NIL THEN
  195.     ERROR ('MakeOperator : Heap Overflow');
  196.       END;
  197.       HOper^.Token    := SymbolToToken(Token,Error) ;
  198.       HOper^.TokenPos := TokenPos;
  199.       HOper^.List     := NIL;
  200.       IF WOp <> NIL THEN
  201.     (* Schon Operator eingetragen *)
  202.     WOp^.List      := HOper;
  203.       ELSE
  204.     (* erster Operator *)
  205.     WPrio^.List    := HOper;
  206.       END;
  207.       (* weiterschalten fuer naechsten Eintrag *)
  208.       WOp         := HOper;
  209.     END;
  210.   END MakeOperator;
  211.  
  212.   PROCEDURE MakeOperHeader
  213.     (OPERPos    : PosType;
  214.      Comment    : tList;
  215.      CommPos     : PosType);
  216.  
  217.   (* Eintragen des Anfangskommentars des Abschnitts OPER sowie der
  218.      Position des Schluesselwortes OPER. *)
  219.  
  220.   BEGIN
  221.       OperVars.OPERPos    := OPERPos;
  222.       OperVars.Comment    := Comment;
  223.       OperVars.CommPos    := CommPos;
  224.       INTOPERExists := TRUE;
  225.   END MakeOperHeader;
  226.  
  227.   PROCEDURE InitPrioReading;
  228.     
  229.     (* Initialisiert das Lesen mit GetPriority *)
  230.  
  231.     BEGIN
  232.       OpenForReading := TRUE;
  233.       RPrio := StartPrio;
  234.     END InitPrioReading;
  235.  
  236.   PROCEDURE GetOperHeader
  237.     (VAR OPERPos  : PosType;
  238.      VAR Comment  : tList;
  239.      VAR CommPos   : PosType): BOOLEAN;
  240.       
  241.   (* Lesen der mit MakeOperHeader abgelegten Information .
  242.      Ist kein OPER- Abschnitt vorhanden, liefert die Prozedur
  243.      als Ergebnis FALSE, sonst TRUE. *)
  244.  
  245.   BEGIN
  246.     IF INTOPERExists THEN
  247.       OPERPos  := OperVars.OPERPos;
  248.       Comment  := OperVars.Comment;
  249.       CommPos  := OperVars.CommPos;
  250.     ELSE
  251.       (* Keine Operheaderinformation vorhanden *)
  252.       OPERPos.Line   := 0;
  253.       OPERPos.Column := 0;
  254.       MakeList (Comment);
  255.       CommPos.Line   := 0;
  256.       CommPos.Column := 0;
  257.     END;
  258.     RETURN INTOPERExists;
  259.   END GetOperHeader;
  260.  
  261.   PROCEDURE GetPriority
  262.     (VAR Kind     : OperKind;
  263.      VAR Pos     : PosType;
  264.      VAR Comment : tList;
  265.      VAR CommPos : PosType): BOOLEAN;
  266.       
  267.   (* Lesen der mit MakePriority und CompletePriority abgelegten
  268.      Information. (FIFO). Ist das Lesen erfolgreich, wird TRUE
  269.      zurueckgeliefert, sonst (Listenende erreicht) FALSE. *)
  270.  
  271.   BEGIN
  272.     IF NOT OpenForReading THEN
  273.       ERROR ('GetPriority : You must not read now');
  274.     END;
  275.     IF RPrio = NIL THEN
  276.       GetOperatorAllowed := FALSE;
  277.       RETURN FALSE;
  278.     ELSE
  279.       Kind      := RPrio^.Kind;
  280.       Pos      := RPrio^.KindPos;
  281.       Comment      := RPrio^.Comment;
  282.       CommPos      := RPrio^.CommPos;
  283.       ROp      := RPrio^.List;
  284.       RPrio      := RPrio^.Next;
  285.       GetOperatorAllowed := TRUE;
  286.       RETURN TRUE;
  287.     END;
  288.   END GetPriority;
  289.  
  290.   PROCEDURE GetOperator (VAR Token: Vocabulary; VAR TokenPos: PosType): BOOLEAN;
  291.  
  292.   (* Lesen der naechsten mit MakeOperator unter der aktuellen 
  293.      Prioritaet abgelegten Information. Ist das Lesen erfolgreich, 
  294.      wird TRUE zurueckgeliefert, sonst (Listenende erreicht) FALSE.
  295.      Nur erlaubt nach erfolgreichem GetPriority *)
  296.  
  297.   BEGIN
  298.     IF NOT GetOperatorAllowed THEN
  299.      ERROR ('GetOperator : Wrong use of procedure');
  300.     END;
  301.     IF ROp = NIL THEN
  302.       RETURN FALSE
  303.     ELSE
  304.       Token      := ROp^.Token;
  305.       TokenPos      := ROp^.TokenPos;
  306.       ROp      := ROp^.List;
  307.       RETURN TRUE;
  308.     END
  309.   END GetOperator;
  310.  
  311.   PROCEDURE ERROR (a : ARRAY OF CHAR);
  312.   VAR s : tString;
  313.   BEGIN
  314.     ArrayToString (a, s);
  315.     ErrorMessageI (eInternal, eFatal, NoPosition, eString, ADR (s));
  316.   END ERROR;
  317.  
  318. BEGIN
  319.   StartPrio       := NIL;
  320.   WPrio           := NIL;    (* Schreibzeiger fuer Priority         *)
  321.   RPrio           := NIL;    (* Lesezeiger fuer Priority         *)
  322.   INTOPERExists       := FALSE;  (* von vorneherein gibt es keinen OPER-Teil*)
  323.   ReadyForOperator := FALSE;  (* Darf Operator geschrieben werden ?     *)
  324.   WOp           := NIL;    (* Lesezeiger fuer Operator         *)
  325.   ROp           := NIL;    (* Schreibzeiger fuer Operator         *)
  326.   OpenForReading   := FALSE;  (* Lesen der Prioritaet gesperrt         *)
  327.   GetOperatorAllowed := FALSE;(* Darf Operator gelesen werden ?         *)
  328.   CurrentPrio       := 0          (* Initialisierung fuer Prioritaet     *)
  329. END Oper.
  330.